home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / DATABASE / FPRODUPS.ZIP / ELIMDUPE.PRG
Text File  |  1993-08-22  |  5KB  |  181 lines
  1. There have been a number of requests for a routine to eliminate
  2. duplicate records from .DBF tables.  In response, I have written
  3. a general purpose utility that can be added (as is) to a FoxPro
  4. application to meet this requirement and am posting it here for
  5. release for public consumption, with limited license.
  6.  
  7. The procedure as written will perform the following steps:
  8.  
  9.         1)  Check for existence of the DUPEFLAG field, and if it
  10.             is not found will modify the table structure, merge
  11.             the existing data and reindex all fields ;
  12.         
  13.         2)  Process all fields, excluding the DUPEFLAG field and
  14.             field types Memo, General, and Picture for determining
  15.             duplicates ;
  16.             
  17.         3)  Make a final pass to correctly mark the first entry of
  18.             a duplicated record and delete subsequent records that
  19.             are flagged as duplicates.
  20.  
  21. With minor modifications, this procedure can be adapted to cover
  22. other xBase dialects, or be applied to specific cases where a
  23. selected subset of the data fields are to be considered, and/or
  24. the increased performance of a less intensive search is desirable.
  25.  
  26. To take advantage of this procedure in applications that you are
  27. developing, add a menu entry for "\<Delete duplicates" or modify
  28. the "\<Construct indexes" in the utilities submenu of the FOXAPP 
  29. project and enter the following code as a procedure.
  30.  
  31.  
  32. *  <start of code snippet>
  33.  
  34. DO elimdupe WITH ALIAS()
  35. SET ORDER TO 1
  36. GOTO TOP
  37. _CUROBJ = 1
  38. WAIT WINDOW "Duplicate deletion completed" NOWAIT
  39. SHOW GETS
  40.  
  41. *  <end of code snippet>
  42.  
  43.  
  44. In addition, the following code for the ELIMDUPE procedure should
  45. be added to the APPPROC.PRG procedure file.  Rebuild the project
  46. and generate the FOXAPP application for the changes to take effect.
  47.  
  48.  
  49. *!******************************************************************
  50. *!
  51. *!      Procedure: ELIMDUPE
  52. *!      Copyright 1993 by Michael D. Long
  53. *!
  54. *!      You are granted the right to use this code, either "as is"
  55. *!      or modified to your particular needs, in applications that
  56. *!      you develop, but only as part of a completed work.  Rights
  57. *!      to publication or other usage where the code is presented
  58. *!      as an individual work are reserved by the author, and in
  59. *!      addition neither the copyright notice nor any portion of
  60. *!      the limitations of the license shall be removed or abridged.
  61. *!
  62. *!******************************************************************
  63. PROCEDURE elimdupe
  64. * Eliminate all duplicate records in current table (mark as deleted)
  65.  
  66. PARAMETERS filname
  67. PRIVATE comp_stat, safe_stat, in_area, fstem, i, dfflag, fsnew, fdnew
  68.  
  69. comp_stat = SET("COMPATIBLE")
  70. safe_stat = SET("SAFETY")
  71. SET COMPATIBLE TO FOXPLUS
  72. SET SAFETY OFF
  73.  
  74. m.in_area = SELECT()          && currently selected area
  75.  
  76. m.fstem = juststem(m.filname)
  77. IF USED(m.fstem)
  78.    SELECT (m.fstem)
  79. ELSE
  80.    SELECT 0
  81.    USE (m.filname)
  82. ENDIF
  83.  
  84. dfflag = .F.
  85. FOR i = 1 TO FCOUNT()
  86.    IF FIELD(i) = "DUPEFLAG"
  87.       dfflag = .T.
  88.    ENDIF
  89. ENDFOR
  90.  
  91. IF !dfflag
  92.    fsnew = SYS(3)
  93.    fdnew = SYS(3)
  94.    COPY STRUCTURE EXTENDED TO (m.fsnew)
  95.    SELECT 0
  96.    USE (m.fsnew)
  97.    APPEND BLANK
  98.    REPLACE field_name WITH 'DUPEFLAG', field_type WITH 'L', ;
  99.            field_len WITH 1, field_dec WITH 0
  100.    USE
  101.    SELECT (m.fstem)
  102.    SET ORDER TO (FIELD(1))
  103.    COPY TO (m.fdnew)
  104.    USE
  105.    CREATE (m.filname) FROM (m.fsnew)
  106.    APPEND FROM (m.fdnew)
  107.    FOR i = 1 TO FCOUNT()
  108.       fldname = FIELD(i)
  109.       IF !INLIST(TYPE(m.fldname),"M","G","P")
  110.          WAIT WINDOW "Indexing on "+m.fldname NOWAIT
  111.          INDEX ON &fldname TAG (m.fldname)
  112.       ENDIF
  113.    ENDFOR
  114.    ERASE (m.fsnew)+".DBF"
  115.    ERASE (m.fdnew)+".DBF"
  116.    IF FILE((m.fdnew)+".FPT")
  117.       ERASE (m.fdnew)+".FPT"
  118.    ENDIF
  119. ENDIF   
  120.  
  121. REPLACE dupeflag WITH .T. FOR NOT DELETED()   
  122.  
  123. SET FILTER TO dupeflag
  124. ffldoccr = 0
  125. FOR i = 1 TO FCOUNT()
  126.    fldname = FIELD(i)
  127.    IF !INLIST(TYPE(m.fldname),"M","G","P")
  128.       IF ffldoccr = 0
  129.          ffldoccr = i        && establish number of first valid field type
  130.       ENDIF
  131.       IF !(m.fldname = "DUPEFLAG  ")
  132.          WAIT WINDOW "Eliminating duplicates on "+m.fldname NOWAIT
  133.          SET ORDER TO (m.fldname)
  134.          GO TOP
  135.          crc = &fldname
  136.          DO WHILE NOT EOF()
  137.             SKIP
  138.             IF crc <> &fldname
  139.                crc = &fldname
  140.                IF NOT EOF()
  141.                   SKIP
  142.                   IF crc <> &fldname
  143.                      SKIP -1
  144.                      REPLACE dupeflag WITH .F.
  145.                   ELSE
  146.                      SKIP -1
  147.                   ENDIF
  148.                ENDIF
  149.             ENDIF
  150.          ENDDO 
  151.       ENDIF
  152.    ENDIF
  153. ENDFOR
  154.  
  155. fldname = FIELD(ffldoccr)
  156. WAIT WINDOW "Tagging duplicates as deleted" NOWAIT
  157. SET ORDER TO (m.fldname)
  158. GO TOP
  159. DO WHILE NOT EOF()
  160.    crc = &fldname
  161.    REPLACE dupeflag WITH .F.
  162.    SKIP
  163.    DO WHILE crc == &fldname AND NOT EOF()
  164.       DELETE NEXT 1
  165.       SKIP
  166.    ENDDO
  167. ENDDO
  168. SET FILTER TO
  169.  
  170. IF m.in_area <> SELECT()
  171.    USE
  172. ENDIF
  173. SELECT (m.in_area)
  174. IF m.comp_stat = "ON" OR m.comp_stat = "DB4"
  175.    SET COMPATIBLE TO DB4
  176. ENDIF
  177. IF m.safe_stat = "ON"
  178.    SET SAFETY ON
  179. ENDIF
  180. RETURN
  181.